--  Simulation of VHDL
--  Copyright (C) 2022 Tristan Gingold
--
--  This file is part of GHDL.
--
--  This program is free software: you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation, either version 2 of the License, or
--  (at your option) any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program.  If not, see <gnu.org/licenses>.

with System;
with Ada.Unchecked_Conversion;

with Types; use Types;
with Tables;

with Libraries;

with Vhdl.Nodes; use Vhdl.Nodes;
with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Utils; use Vhdl.Utils;
with Vhdl.Back_End;
with Vhdl.Configuration;
with Vhdl.Std_Package;
with Vhdl.Ieee.Std_Logic_1164;
with Vhdl.Sem_Inst;

with Elab.Memtype; use Elab.Memtype;
with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
with Elab.Vhdl_Values; use Elab.Vhdl_Values;
with Elab.Vhdl_Context; use Elab.Vhdl_Context;
with Elab.Vhdl_Prot;
with Elab.Vhdl_Heap;
with Elab.Vhdl_Insts;

with Synth.Vhdl_Expr;
with Synth.Vhdl_Stmts;

with Simul.Vhdl_Elab; use Simul.Vhdl_Elab;
with Simul.Vhdl_Simul;
with Simul.Main;

with Translation;
with Trans; use Trans; use Trans.Chap10;
with Trans.Chap4;
with Trans.Chap7;
with Trans.Chap9;
with Trans.Rtis;
with Trans_Link;
with Trans_Foreign;
with Trans_Decls;
with Trans.Coverage;

with Grt.Types; use Grt.Types;
with Grt.Processes;
with Grt.Signals;

with Grt.Rtis;
with Grtlink;

with Ortho_Nodes; use Ortho_Nodes;
with Ortho_Jit; use Ortho_Jit;

package body Simul.Vhdl_Compile is
   function Alloc_Mem (Sz : Size_Type) return Memory_Ptr;
   pragma Import (C, Alloc_Mem, "malloc");

   type Process_State_Type is record
      Subprg : Grt.Processes.Proc_Acc;
      This : Grt.Processes.Instance_Acc;
      Mem : Memory_Ptr;
   end record;

   type Process_State_Array is
      array (Process_Index_Type range <>) of aliased Process_State_Type;
   type Process_State_Array_Acc is access Process_State_Array;

   package Instance_To_Mem_Table is new Tables
     (Table_Component_Type => Memory_Ptr,
      Table_Index_Type => Instance_Id_Type,
      Table_Low_Bound => First_Instance_Id,
      Table_Initial => 16);

   type External_Name_Record is record
      Mem : Memory_Ptr;
      Inst : Synth_Instance_Acc;
      Name : Node;
   end record;

   --  Table of external signal names to be resolved at the end.
   package External_Names_Table is new Tables
     (Table_Component_Type => External_Name_Record,
      Table_Index_Type => Natural,
      Table_Low_Bound => 1,
      Table_Initial => 16);

   --  Array of processes, using the same order (and index) as the process
   --  table for elaboration.
   Processes_State : Process_State_Array_Acc;
   Process_Idx : Process_Index_Type;

   --  Create the memory representing the instance, as expected by code
   --  generated by translation.
   --  Called for top-level, component/direct instantiation
   function Build_Elab_Instance (Inst : Synth_Instance_Acc) return Memory_Ptr;

   procedure Build_Stmts_Instance (Mem : Memory_Ptr;
                                   Base_Mem : Memory_Ptr;
                                   Inst : Synth_Instance_Acc;
                                   Chain : Node);
   procedure Build_Decls_Instance (Mem : Memory_Ptr;
                                   Inst : Synth_Instance_Acc;
                                   Chain : Node);
   procedure Build_Decl_Instance (Mem : Memory_Ptr;
                                  Inst : Synth_Instance_Acc;
                                  Decl : Node);

   procedure Set_Instance_To_Mem (Inst : Synth_Instance_Acc; Mem : Memory_Ptr)
   is
      Id : constant Instance_Id_Type := Get_Instance_Id (Inst);
      Last : constant Instance_Id_Type := Instance_To_Mem_Table.Last;
   begin
      if Last < Id then
         Instance_To_Mem_Table.Reserve (Natural (Id - Last));
         while Instance_To_Mem_Table.Last < Id loop
            Instance_To_Mem_Table.Append (null);
         end loop;
      end if;
      Instance_To_Mem_Table.Table (Id) := Mem;
   end Set_Instance_To_Mem;

   function Add_Field_Offset (Mem : Memory_Ptr; F : O_Fnode)
                             return Memory_Ptr is
   begin
      return Mem + Size_Type (Get_Field_Offset (F));
   end Add_Field_Offset;

   function Get_Var_Mem (Mem : Memory_Ptr; Var : Var_Type) return Memory_Ptr is
   begin
      if Is_Var_Field (Var) then
         declare
            F : constant O_Fnode := Trans.Chap10.Get_Var_Field (Var);
         begin
            return Add_Field_Offset (Mem, F);
         end;
      else
         return To_Memory_Ptr (Get_Address (Get_Var_Label (Var)));
      end if;
   end Get_Var_Mem;

   procedure Write_Bound
     (Mem : Memory_Ptr; Val : Int32; Mode : Type_Mode_Discrete) is
   begin
      case Mode is
         when Type_Mode_B1
           | Type_Mode_E8 =>
            Write_U8 (Mem, Ghdl_U8 (Val));
         when Type_Mode_E32
           | Type_Mode_I32 =>
            Write_I32 (Mem, Ghdl_I32 (Val));
         when Type_Mode_I64 =>
            Write_I64 (Mem, Ghdl_I64 (Val));
      end case;
   end Write_Bound;

   procedure Write_Scalar
     (Mem : Memory_Ptr; Val : Int64; Mode : Type_Mode_Scalar) is
   begin
      case Mode is
         when Type_Mode_B1
           | Type_Mode_E8 =>
            Write_U8 (Mem, Ghdl_U8 (Val));
         when Type_Mode_E32
           | Type_Mode_I32
           | Type_Mode_P32 =>
            Write_I32 (Mem, Ghdl_I32 (Val));
         when Type_Mode_I64
           | Type_Mode_P64 =>
            Write_I64 (Mem, Ghdl_I64 (Val));
         when Type_Mode_F64 =>
            raise Internal_Error;
      end case;
   end Write_Scalar;

   procedure Write_Dir (Mem : Memory_Ptr; Dir : Direction_Type) is
   begin
      Write_U8 (Mem, Direction_Type'Pos (Dir));
   end Write_Dir;

   procedure Write_Length (Mem : Memory_Ptr; Len : Uns32) is
   begin
      --  TODO: check ghdl_index_type size ?
      Write_U32 (Mem, Ghdl_U32 (Len));
   end Write_Length;

   procedure Write_Bounds (Mem : Memory_Ptr; Bnd : Bound_Type; Btype : Node)
   is
      Binfo : constant Type_Info_Acc := Get_Info (Btype);
   begin
      Write_Bound (Add_Field_Offset (Mem, Binfo.B.Range_Left),
                   Bnd.Left, Binfo.Type_Mode);
      Write_Bound (Add_Field_Offset (Mem, Binfo.B.Range_Right),
                   Bnd.Right, Binfo.Type_Mode);
      Write_Dir (Add_Field_Offset (Mem, Binfo.B.Range_Dir),
                 Bnd.Dir);
      Write_Length (Add_Field_Offset (Mem, Binfo.B.Range_Length),
                    Bnd.Len);
   end Write_Bounds;

   procedure Write_Size (Mem : Memory_Ptr;
                         Def : Node;
                         Typ : Type_Acc) is
   begin
      Write_Length (Mem, Uns32 (Typ.Sz));
      if Get_Has_Signal_Flag (Def) then
         Write_Length (Mem + 4, Typ.W * Uns32 (Vhdl_Simul.Sig_Size));
      end if;
   end Write_Size;

   procedure Write_Unbounded (Mem : Memory_Ptr;
                              Tinfo : Type_Info_Acc;
                              Mode : Object_Kind_Type;
                              Bnd : Memory_Ptr;
                              Val : Memory_Ptr) is
   begin
      Write_Ptr (Add_Field_Offset (Mem, Tinfo.B.Bounds_Field (Mode)), Bnd);
      Write_Ptr (Add_Field_Offset (Mem, Tinfo.B.Base_Field (Mode)), Val);
   end Write_Unbounded;

   procedure Build_Scalar_Subtype_Range (Mem : Memory_Ptr;
                                         Def : Node;
                                         Typ : Type_Acc)
   is
      Tinfo : constant Type_Info_Acc := Get_Info (Def);
      Rng : Discrete_Range_Type renames Typ.Drange;
      Len : Uns32;
   begin
      Write_Scalar (Add_Field_Offset (Mem, Tinfo.B.Range_Left),
                    Rng.Left, Tinfo.Type_Mode);
      Write_Scalar (Add_Field_Offset (Mem, Tinfo.B.Range_Right),
                    Rng.Right, Tinfo.Type_Mode);
      Write_Dir (Add_Field_Offset (Mem, Tinfo.B.Range_Dir),
                 Rng.Dir);
      if Tinfo.B.Range_Length /= O_Fnode_Null then
         case Typ.Drange.Dir is
            when Dir_To =>
               if Rng.Left > Rng.Right then
                  Len := 0;
               else
                  Len := Uns32 (Rng.Right - Rng.Left + 1);
               end if;
            when Dir_Downto =>
               if Rng.Left < Rng.Right then
                  Len := 0;
               else
                  Len := Uns32 (Rng.Left - Rng.Right + 1);
            end if;
         end case;
         Write_Length (Add_Field_Offset (Mem, Tinfo.B.Range_Length), Len);
      end if;
   end Build_Scalar_Subtype_Range;

   procedure Build_Composite_Subtype_Layout (Mem : Memory_Ptr;
                                             Def : Node;
                                             Typ : Type_Acc);

   procedure Build_Array_Subtype_Bounds (Mem : Memory_Ptr;
                                         Def : Node;
                                         Typ : Type_Acc)
   is
      El_Type         : constant Iir := Get_Element_Subtype (Def);
      El_Info         : constant Type_Info_Acc := Get_Info (El_Type);

      Base_Indexes_List : constant Iir_Flist :=
        Get_Index_Subtype_Definition_List (Get_Base_Type (Def));
      Base_Index_Tm : Node;
      Base_Index_Type : Node;
      Base_Index_Info : Index_Info_Acc;
      Idx_Mem : Memory_Ptr;
      Idx_Typ : Type_Acc;
      Tinfo : Type_Info_Acc;
   begin
      Idx_Typ := Typ;
      for I in Flist_First .. Flist_Last (Base_Indexes_List) loop
         Base_Index_Tm := Get_Nth_Element (Base_Indexes_List, I);
         Base_Index_Type :=
           Get_Type_Of_Subtype_Indication (Base_Index_Tm);
         Base_Index_Info := Get_Info (Base_Index_Tm);
         Idx_Mem := Add_Field_Offset (Mem, Base_Index_Info.Index_Field);
         Write_Bounds
           (Idx_Mem, Idx_Typ.Abound, Get_Base_Type (Base_Index_Type));
         Idx_Typ := Idx_Typ.Arr_El;
      end loop;

      if Is_Unbounded_Type (El_Info) then
         Tinfo := Get_Info (Def);
         Idx_Mem := Add_Field_Offset (Mem, Tinfo.B.Bounds_El);
         Build_Composite_Subtype_Layout(Idx_Mem, El_Type, Idx_Typ);
      end if;
   end Build_Array_Subtype_Bounds;

   procedure Build_Array_Subtype_Layout (Mem : Memory_Ptr;
                                         Def : Node;
                                         Typ : Type_Acc)
   is
      Tinfo : constant Type_Info_Acc := Get_Info (Def);
      Bnd_Mem : Memory_Ptr;
   begin
      Bnd_Mem := Add_Field_Offset (Mem, Tinfo.B.Layout_Bounds);

      case Typ.Kind is
         when Type_Array
           | Type_Array_Unbounded
           | Type_Vector =>
            --  Write bounds only if the type is constrained.
            declare
               Sz_Mem : Memory_Ptr;
            begin
               Sz_Mem := Add_Field_Offset (Mem, Tinfo.B.Layout_Size);
               Write_Size (Sz_Mem, Def, Typ);
               Build_Array_Subtype_Bounds (Bnd_Mem, Def, Typ);
            end;
         when Type_Unbounded_Array
           | Type_Unbounded_Vector =>
            null;
         when others =>
            raise Internal_Error;
      end case;

      if Tinfo.B.Bounds_El /= O_Fnode_Null then
         declare
            El_Bnd_Mem : Memory_Ptr;
         begin
            El_Bnd_Mem := Add_Field_Offset (Bnd_Mem, Tinfo.B.Bounds_El);
            Build_Composite_Subtype_Layout
              (El_Bnd_Mem, Get_Element_Subtype (Def),
               Get_Array_Element (Typ));
         end;
      end if;
   end Build_Array_Subtype_Layout;

   --  Write the content of an STL variable for record DEF.
   --  Sizes, followed by offsets and bounds for each unbounded elements.
   --  Note: for records layout = bounds.
   --  Cf: trans.chap3.elab_composite_subtype_layout.
   procedure Build_Record_Subtype_Layout (Mem : Memory_Ptr;
                                          Def : Node;
                                          Typ : Type_Acc)
   is
      El_List : constant Iir_Flist :=
        Get_Elements_Declaration_List (Def);
      Base_El_List : constant Iir_Flist :=
        Get_Elements_Declaration_List (Get_Base_Type (Def));
   begin
      Write_Size (Mem, Def, Typ);

      for I in Flist_First .. Flist_Last (El_List) loop
         declare
            El : constant Node := Get_Nth_Element (El_List, I);
            Base_El : constant Node := Get_Nth_Element (Base_El_List, I);
            El_Type : constant Node := Get_Type (Base_El);
            El_Tinfo : constant Type_Info_Acc := Get_Info (El_Type);
            Is_Unbounded : constant Boolean := Is_Unbounded_Type (El_Tinfo);
            El_Info : Ortho_Info_Acc;
            El_Mem : Memory_Ptr;
            Idx : Iir_Index32;
         begin
            if Is_Unbounded or Is_Complex_Type (El_Tinfo) then
               Idx := Iir_Index32 (I - Flist_First + 1);
               El_Info := Get_Info (Base_El);

               --  _OFF
               El_Mem := Add_Field_Offset
                 (Mem, El_Info.Field_Node (Mode_Value));
               Write_Length (El_Mem, Uns32 (Typ.Rec.E (Idx).Offs.Mem_Off));

               --  _SIGOFF
               if Get_Has_Signal_Flag (Def) then
                  El_Mem := Add_Field_Offset
                    (Mem, El_Info.Field_Node (Mode_Signal));
                  Write_Length (El_Mem, (Typ.Rec.E (Idx).Offs.Net_Off
                                           * Uns32 (Vhdl_Simul.Sig_Size)));
               end if;

               --  _BND (layout)
               if Is_Unbounded then
                  El_Mem := Add_Field_Offset (Mem, El_Info.Field_Bound);
                  Build_Composite_Subtype_Layout
                    (El_Mem, Get_Type (El), Typ.Rec.E (Idx).Typ);
               end if;
            end if;
         end;
      end loop;
   end Build_Record_Subtype_Layout;

   procedure Build_Composite_Subtype_Layout (Mem : Memory_Ptr;
                                             Def : Node;
                                             Typ : Type_Acc) is
   begin
      case Get_Kind (Def) is
         when Iir_Kind_Array_Subtype_Definition
            | Iir_Kind_Array_Type_Definition =>
            Build_Array_Subtype_Layout (Mem, Def, Typ);
         when Iir_Kind_Record_Subtype_Definition
            | Iir_Kind_Record_Type_Definition =>
            Build_Record_Subtype_Layout (Mem, Def, Typ);
         when others =>
            Error_Kind ("build_composite_subtype_layout", Def);
      end case;
   end Build_Composite_Subtype_Layout;

   procedure Build_Subtype_Definition (Mem : Memory_Ptr;
                                       Def : Node;
                                       Typ : Type_Acc) is
   begin
      if Def = Null_Node then
         return;
      end if;
      case Get_Kind (Def) is
         when Iir_Kinds_Denoting_Name
           | Iir_Kind_Element_Attribute
           | Iir_Kind_Subtype_Attribute =>
            null;
         when Iir_Kind_Integer_Subtype_Definition
            | Iir_Kind_Enumeration_Subtype_Definition
            | Iir_Kind_Physical_Subtype_Definition
            | Iir_Kind_Floating_Subtype_Definition =>
            if Get_Type_Staticness (Def) = Locally then
               return;
            end if;
            declare
               Info : constant Type_Info_Acc := Get_Info (Def);
               Rng_Mem : Memory_Ptr;
            begin
               if not Info.S.Same_Range then
                  Rng_Mem := Get_Var_Mem (Mem, Info.S.Range_Var);
                  Build_Scalar_Subtype_Range (Rng_Mem, Def, Typ);
               end if;
            end;
         when Iir_Kind_Array_Subtype_Definition =>
            --  If is static, already done.
            Convert_Type_Width (Typ);
            if Get_Type_Staticness (Def) = Locally then
               return;
            end if;
            declare
               Info : constant Type_Info_Acc := Get_Info (Def);
               Lay_Mem : Memory_Ptr;
            begin
               if Info /= null
                 and then Info.Type_Mode /= Type_Mode_Static_Array
               then
                  Lay_Mem := Get_Var_Mem (Mem, Info.S.Composite_Layout);
                  Build_Array_Subtype_Layout (Lay_Mem, Def, Typ);
               end if;
            end;
         when Iir_Kind_Record_Subtype_Definition =>
            if Get_Owned_Elements_Chain (Def) = Null_Iir then
               --  No new element constraints, so no new layout.
               return;
            end if;
            Convert_Type_Width (Typ);
            declare
               Info : constant Type_Info_Acc := Get_Info (Def);
               Lay_Mem : Memory_Ptr;
            begin
               if Info.Type_Mode /= Type_Mode_Static_Record then
                  Lay_Mem := Get_Var_Mem (Mem, Info.S.Composite_Layout);
                  Build_Record_Subtype_Layout (Lay_Mem, Def, Typ);
               end if;
            end;
         when Iir_Kind_File_Subtype_Definition =>
            null;
         when Iir_Kind_Access_Subtype_Definition =>
            declare
               Ind : constant Node := Get_Designated_Subtype_Indication (Def);
            begin
               if Ind /= Null_Node then
                  Build_Subtype_Definition (Mem, Ind, Typ.Acc_Acc);
               end if;
            end;
         when others =>
            Error_Kind ("build_subtype_definition", Def);
      end case;
   end Build_Subtype_Definition;

   procedure Build_Subtype_Indication (Mem : Memory_Ptr;
                                       Inst : Synth_Instance_Acc;
                                       Def : Node) is
   begin
      if Def = Null_Node then
         return;
      end if;
      case Get_Kind (Def) is
         when Iir_Kinds_Denoting_Name
           | Iir_Kind_Element_Attribute
           | Iir_Kind_Subtype_Attribute =>
            return;
         when Iir_Kind_Integer_Subtype_Definition
            | Iir_Kind_Enumeration_Subtype_Definition
            | Iir_Kind_Physical_Subtype_Definition
            | Iir_Kind_Floating_Subtype_Definition =>
            if Get_Type_Staticness (Def) = Locally then
               return;
            end if;
         when Iir_Kind_Array_Subtype_Definition =>
            null;
         when Iir_Kind_Record_Subtype_Definition =>
            if Get_Owned_Elements_Chain (Def) = Null_Iir then
               --  No new element constraints, so no new layout.
               return;
            end if;
         when Iir_Kind_File_Subtype_Definition =>
            return;
         when Iir_Kind_Access_Subtype_Definition =>
            null;
         when others =>
            Error_Kind ("build_subtype_indication", Def);
      end case;
      Build_Subtype_Definition (Mem, Def, Get_Subtype_Object (Inst, Def));
   end Build_Subtype_Indication;

   procedure Build_Type_Definition (Mem : Memory_Ptr;
                                    Inst : Synth_Instance_Acc;
                                    Def : Node) is
   begin
      case Get_Kind (Def) is
         when Iir_Kind_Access_Type_Definition =>
            --  Check sim and compile have the same size for bounds.
            declare
               Dtype : constant Node := Get_Designated_Type (Def);
               Dinfo : constant Type_Info_Acc := Get_Info (Dtype);
               Typ : constant Type_Acc := Get_Subtype_Object (Inst, Def);
               Sz : Size_Type;
            begin
               Build_Subtype_Definition
                 (Mem, Get_Designated_Subtype_Indication (Def), Typ.Acc_Acc);

               if not Is_Fully_Constrained_Type (Dtype) then
                  Sz := Size_Type (Get_Byte_Size (Dinfo.B.Bounds_Type));
               else
                  Sz := 0;
               end if;
               if Sz /= Typ.Acc_Bnd_Sz then
                  raise Internal_Error;
               end if;
            end;

         when Iir_Kind_File_Type_Definition =>
            null;
         when Iir_Kind_Enumeration_Type_Definition
            | Iir_Kind_Integer_Type_Definition
            | Iir_Kind_Floating_Type_Definition =>
            null;
         when Iir_Kind_Physical_Type_Definition =>
            --  FIXME: handle standard.time ?
            null;
         when Iir_Kind_Record_Type_Definition =>
            declare
               Typ : constant Type_Acc := Get_Subtype_Object (Inst, Def);
               Els : constant Iir_Flist := Get_Elements_Declaration_List (Def);
               Info : constant Type_Info_Acc := Get_Info (Def);
               El : Node;
               El_St : Node;
               Lay_Mem : Memory_Ptr;
            begin
               Convert_Type_Width (Typ);
               for I in Flist_First .. Flist_Last (Els) loop
                  El := Get_Nth_Element (Els, I);
                  El_St := Get_Subtype_Indication (El);
                  Build_Subtype_Definition
                    (Mem, El_St,
                     Typ.Rec.E (Iir_Index32 (I - Flist_First + 1)).Typ);
               end loop;

               if Info.S.Composite_Layout /= Null_Var
                 and then Info.Type_Mode /= Type_Mode_Static_Record
               then
                  Lay_Mem := Get_Var_Mem (Mem, Info.S.Composite_Layout);
                  Build_Record_Subtype_Layout (Lay_Mem, Def, Typ);
               end if;
            end;
         when Iir_Kind_Array_Type_Definition =>
            Build_Subtype_Indication
              (Mem, Inst, Get_Element_Subtype_Indication (Def));

            --  TODO
         when Iir_Kind_Protected_Type_Declaration =>
            --  For anonymous subtype in subprogram interfaces.
            Build_Decls_Instance (Mem, Inst, Get_Declaration_Chain (Def));
         when Iir_Kind_Incomplete_Type_Definition =>
            null;
         when others =>
            Error_Kind ("build_type_definition", Def);
      end case;
   end Build_Type_Definition;

   function Build_Unbounded_Bounds (Tinfo : Type_Info_Acc;
                                    Atype : Node;
                                    Typ : Type_Acc) return Memory_Ptr
   is
      Sz : Size_Type;
      Bnd : Memory_Ptr;
   begin
      --  Allocate bounds.
      Sz := Size_Type (Get_Byte_Size (Tinfo.B.Bounds_Type));
      Bnd := Alloc_Mem (Sz);

      case Get_Kind (Atype) is
         when Iir_Kind_Array_Type_Definition
           | Iir_Kind_Array_Subtype_Definition =>
            Build_Array_Subtype_Bounds (Bnd, Atype, Typ);
         when Iir_Kind_Record_Type_Definition
           | Iir_Kind_Record_Subtype_Definition =>
            Build_Record_Subtype_Layout (Bnd, Atype, Typ);
         when others =>
            Error_Kind ("build_unbounded_bounds", Atype);
      end case;

      return Bnd;
   end Build_Unbounded_Bounds;

   --  Add bounds to heap slots.
   procedure Build_Heap_Bounds
   is
      use Elab.Vhdl_Heap;
      Ptr : Memory_Ptr;
      Typ : Type_Acc;
      Def : Node;
   begin
      for I in First_Heap_Slot .. Get_Last_Slot loop
         Typ := Get_Slot_Acc_Type (I);
         if Typ /= null and then Typ.Acc_Bnd_Sz /= 0 then
            Ptr := Insert_Bounds (I, Typ.Acc_Bnd_Sz);
            Def := Get_Slot_Type_Def (I);
            Def := Get_Designated_Type (Def);
            Typ := Get_Slot_Obj_Type (I);
            case Typ.Kind is
               when Type_Vectors_Arrays =>
                  Build_Array_Subtype_Bounds (Ptr, Def, Typ);
               when Type_Records =>
                  Build_Record_Subtype_Layout (Ptr, Def, Typ);
               when others =>
                  raise Internal_Error;
            end case;
         end if;
      end loop;
   end Build_Heap_Bounds;

   procedure Build_Unbounded_Signal (Val_Mem : Memory_Ptr;
                                     Sig_Mem : Memory_Ptr;
                                     Tinfo : Type_Info_Acc;
                                     Sig_Type : Node;
                                     Typ : Type_Acc;
                                     Val : Memory_Ptr;
                                     Sig : Memory_Ptr)
   is
      Bnd : Memory_Ptr;
   begin
      Bnd := Build_Unbounded_Bounds (Tinfo, Sig_Type, Typ);

      Write_Unbounded (Val_Mem, Tinfo, Mode_Value, Bnd, Val);
      Write_Unbounded (Sig_Mem, Tinfo, Mode_Signal, Bnd, Sig);
   end Build_Unbounded_Signal;

   function Build_Protected_Object (Prot : Protected_Index) return Memory_Ptr
   is
      Prot_Inst : constant Synth_Instance_Acc := Elab.Vhdl_Prot.Get (Prot);
      Bod : constant Node := Get_Source_Scope (Prot_Inst);
      pragma Assert (Get_Kind (Bod) = Iir_Kind_Protected_Type_Body);
      Prot_Type : constant Node := Get_Protected_Type_Declaration (Bod);
      Info : constant Type_Info_Acc := Get_Info (Prot_Type);
      Bod_Otype : constant O_Tnode :=
        Trans.Chap10.Get_Scope_Type (Info.B.Prot_Scope);
      Sz : Size_Type;
      Res : Memory_Ptr;
      Mem : Memory_Ptr;
   begin
      --  Allocate memory for the protected object.
      Sz := Size_Type (Get_Byte_Size (Bod_Otype));
      Res := Alloc_Mem (Sz);

      Set_Instance_To_Mem (Prot_Inst, Res);

      --  Set prev scope.
      if Info.B.Prot_Prev_Scope /= null then
         Mem := Add_Field_Offset (Res, Info.B.Prot_Subprg_Instance_Field);
         Write_Ptr (Mem, Instance_To_Mem_Table.Table
                      (Get_Instance_Id
                         (Get_Instance_Parent (Prot_Inst))));
      end if;

      --  Set lock
      Mem := Add_Field_Offset (Res, Info.B.Prot_Lock_Field);
      Grt.Processes.Ghdl_Protected_Init (To_Address (Mem));

      --  copy vars.
      Build_Decls_Instance (Res, Prot_Inst, Get_Declaration_Chain (Bod));
      return Res;
   end Build_Protected_Object;

   procedure Build_Object_Value (Mem : Memory_Ptr;
                                 Inst : Synth_Instance_Acc;
                                 Decl : Node)
   is
      Var_Info : constant Object_Info_Acc := Get_Info (Decl);
      Var_Type : constant Node := Get_Type (Decl);
      Tinfo : constant Type_Info_Acc := Get_Info (Var_Type);
      Src_Vt : constant Valtyp := Get_Value (Inst, Decl);
      Src : constant Memtyp := Get_Memtyp (Src_Vt);
      Dst_Mem : Memory_Ptr;
   begin
      Dst_Mem := Get_Var_Mem (Mem, Var_Info.Object_Var);

      case Src.Typ.Kind is
         when Type_Access =>
            declare
               Ptr : constant Heap_Ptr := Read_Access (Src);
            begin
               Write_Access (Dst_Mem, Ptr);
               Src_Vt.Val.Mem := Dst_Mem;
            end;
         when Type_Protected =>
            declare
               Prot : constant Protected_Index := Read_Protected (Src.Mem);
               Res : Memory_Ptr;
            begin
               Res := Build_Protected_Object (Prot);
               Write_Ptr (Dst_Mem, Res);
            end;
         when others =>
            if Is_Unbounded_Type (Tinfo) then
               declare
                  Bnd : Memory_Ptr;
               begin
                  Bnd := Build_Unbounded_Bounds (Tinfo, Var_Type, Src.Typ);

                  Write_Unbounded (Dst_Mem, Tinfo, Mode_Value, Bnd, Src.Mem);
               end;
            elsif Is_Complex_Type (Tinfo) then
               Write_Ptr (Dst_Mem, Src.Mem);
            else
               Elab.Vhdl_Objtypes.Copy_Memory (Dst_Mem, Src.Mem, Src.Typ.Sz);

               --  If src_vt is an alias (when a generic is associated to an
               --  alias), nothing to update.
               if Src_Vt.Val.Kind = Value_Memory then
                  Src_Vt.Val.Mem := Dst_Mem;
               end if;
            end if;
      end case;
   end Build_Object_Value;

   procedure Build_Object_Decl (Mem : Memory_Ptr;
                                Inst : Synth_Instance_Acc;
                                Decl : Node)
   is
      Val : constant Valtyp := Get_Value (Inst, Decl);
   begin
      Build_Subtype_Definition (Mem, Get_Subtype_Indication (Decl), Val.Typ);
      Build_Object_Value (Mem, Inst, Decl);
   end Build_Object_Decl;

   procedure Build_Package_Instantiation (Mem : Memory_Ptr;
                                          Inst : Synth_Instance_Acc;
                                          Pkg : Node)
   is
      Info : constant Ortho_Info_Acc := Get_Info (Pkg);
      Pkg_Mem : Memory_Ptr;
   begin
      if Info.Kind = Kind_Package then
         --  Macro-expanded (either at top-level or within an block)
         Pkg_Mem := Mem;
         declare
            Assoc, Assoc_Inter, Inter : Node;
         begin
            Assoc := Get_Generic_Map_Aspect_Chain (Pkg);
            Assoc_Inter := Get_Generic_Chain (Pkg);
            while Assoc /= Null_Node loop
               Inter := Get_Association_Interface (Assoc, Assoc_Inter);

               if Get_Kind (Inter) = Iir_Kind_Interface_Type_Declaration then
                  declare
                     Def : constant Node := Get_Actual (Assoc);
                  begin
                     if Is_Proper_Subtype_Indication (Def) then
                        Build_Subtype_Indication (Mem, Inst, Def);
                     end if;
                  end;
               else
                  Build_Decl_Instance (Pkg_Mem, Inst, Inter);
               end if;

               Next_Association_Interface (Assoc, Assoc_Inter);
            end loop;
         end;

         Build_Decls_Instance (Pkg_Mem, Inst, Get_Declaration_Chain (Pkg));

         declare
            Bod : constant Node := Get_Instance_Package_Body (Pkg);
         begin
            if Bod /= Null_Node then
               --  Macro expanded package.
               Build_Decls_Instance
                 (Pkg_Mem, Inst, Get_Declaration_Chain (Bod));
            end if;
         end;
      elsif Info.Kind = Kind_Package_Instance then
         Pkg_Mem := Get_Var_Mem (Mem, Info.Package_Instance_Body_Var);

         Build_Decls_Instance (Pkg_Mem, Inst, Get_Generic_Chain (Pkg));
         Build_Decls_Instance (Pkg_Mem, Inst, Get_Declaration_Chain (Pkg));

         --  Shared body
         declare
            Uninst : constant Node := Get_Uninstantiated_Package_Decl (Pkg);
            Uninst_Bod : constant Node := Get_Package_Body (Uninst);
         begin
            --  Synth declarations of (optional) body.
            if Uninst_Bod /= Null_Node then
               Build_Decls_Instance
                 (Pkg_Mem, Inst, Get_Declaration_Chain (Uninst_Bod));
            end if;
         end;
      else
         raise Internal_Error;
      end if;

      Set_Instance_To_Mem (Inst, Pkg_Mem);
   end Build_Package_Instantiation;

   procedure Build_Signal_Decl (Mem : Memory_Ptr;
                                Inst : Synth_Instance_Acc;
                                Decl : Node)
   is
      Sig_Info : constant Signal_Info_Acc := Get_Info (Decl);
      Sig_Type : constant Node := Get_Type (Decl);
      Tinfo : constant Type_Info_Acc := Get_Info (Sig_Type);
      Src : constant Valtyp := Get_Value (Inst, Decl);
      E : Signal_Entry renames Signals_Table.Table (Src.Val.S);
      Sig, Val : Memory_Ptr;
   begin
      pragma Assert (Sig_Info.Signal_Driver = Null_Var);

      --  The _SIG and _VAL/_VALP
      Sig := Get_Var_Mem (Mem, Sig_Info.Signal_Sig);
      Val := Get_Var_Mem (Mem, Sig_Info.Signal_Val);

      if Is_Unbounded_Type (Tinfo) then
         --  _SIG is BASEP+BOUNDP, _VALP is pointer to BASEP+BOUNDP
         E.Sig := Alloc_Mem (Size_Type (Src.Typ.W) * Vhdl_Simul.Sig_Size);
         Build_Unbounded_Signal
           (Val, Sig, Tinfo, Sig_Type, Src.Typ, E.Val, E.Sig);
      elsif Is_Complex_Type (Tinfo) then
         Write_Ptr (Val, E.Val);
         E.Sig := Alloc_Mem (Size_Type (Src.Typ.W) * Vhdl_Simul.Sig_Size);
         Write_Ptr (Sig, E.Sig);
      else
         --  Copy initial value to current value.
         Elab.Vhdl_Objtypes.Copy_Memory (Val, E.Val, Src.Typ.Sz);
         E.Val := Val;
         E.Sig := Sig;
      end if;

      Vhdl_Simul.Create_Signal (E);
   end Build_Signal_Decl;

   procedure Build_Object_Alias (Mem : Memory_Ptr;
                                 Inst : Synth_Instance_Acc;
                                 Decl : Node)
   is
      Info : constant Alias_Info_Acc := Get_Info (Decl);
      Src_Type : constant Node := Get_Type (Decl);
      Tinfo : constant Type_Info_Acc := Get_Info (Src_Type);
      Src : constant Valtyp := Get_Value (Inst, Decl);
      Obj : constant Value_Acc := Src.Val.A_Obj;
      Var_Mem : Memory_Ptr;
      Src_Ptr : Memory_Ptr;
   begin
      Build_Subtype_Indication
        (Mem, Inst, Get_Subtype_Indication (Decl));

      if Get_Kind (Decl) = Iir_Kind_Object_Alias_Declaration then
         declare
            Name : constant Node := Get_Name (Decl);
         begin
            if Get_Kind (Name) = Iir_Kind_Slice_Name then
               --  Add layout
               declare
                  Name_Type : constant Node := Get_Type (Name);
                  Name_Tinfo : constant Type_Info_Acc := Get_Info (Name_Type);
                  Lay_Mem : Memory_Ptr;
               begin
                  if Name_Tinfo.Type_Mode /= Type_Mode_Static_Array then
                     Lay_Mem :=
                       Get_Var_Mem (Mem, Name_Tinfo.S.Composite_Layout);
                     Build_Composite_Subtype_Layout
                       (Lay_Mem, Name_Type, Src.Typ);
                  end if;
               end;
            end if;
         end;
      end if;

      for Mode in Mode_Value .. Info.Alias_Kind loop
         Var_Mem := Get_Var_Mem (Mem, Info.Alias_Var (Mode));
         case Obj.Kind is
            when Value_Signal =>
               case Mode is
                  when Mode_Value =>
                     Src_Ptr := Signals_Table.Table (Obj.S).Val
                       + Src.Val.A_Off.Mem_Off;
                  when Mode_Signal =>
                     Src_Ptr := Signals_Table.Table (Obj.S).Sig
                       + (Size_Type (Src.Val.A_Off.Net_Off)
                            * Vhdl_Simul.Sig_Size);
               end case;
            when Value_Memory =>
               pragma Assert (Mode = Mode_Value);
               Src_Ptr := Obj.Mem + Src.Val.A_Off.Mem_Off;
            when others =>
               raise Internal_Error;
         end case;
         case Tinfo.Type_Mode is
            when Type_Mode_Bounded_Arrays
              | Type_Mode_Bounded_Records =>
               Write_Ptr (Var_Mem, Src_Ptr);
            when Type_Mode_Protected =>
               declare
                  Prot_Idx : constant Protected_Index :=
                    Read_Protected (Src_Ptr);
                  Prot_Inst : constant Synth_Instance_Acc :=
                    Elab.Vhdl_Prot.Get (Prot_Idx);
                  Prot_Mem : Memory_Ptr;
               begin
                  Prot_Mem := Instance_To_Mem_Table.Table
                    (Get_Instance_Id (Prot_Inst));
                  Write_Ptr (Var_Mem, Prot_Mem);
               end;
            when Type_Mode_Scalar =>
               case Mode is
                  when Mode_Value =>
                     Write_Ptr (Var_Mem, Src_Ptr);
                  when Mode_Signal =>
                     --  Copy sig.
                     Write_Ptr (Var_Mem, Read_Ptr (Src_Ptr));
               end case;
            when Type_Mode_Unbounded_Array
              | Type_Mode_Unbounded_Record =>
               declare
                  Bnd : Memory_Ptr;
               begin
                  --  TODO: get the bounds from the name instead of
                  --  re-creating them (twice!).
                  Bnd := Build_Unbounded_Bounds (Tinfo, Src_Type, Src.Typ);

                  Write_Unbounded (Var_Mem, Tinfo, Mode, Bnd, Src_Ptr);
               end;
            when others =>
               raise Internal_Error;
         end case;
      end loop;
   end Build_Object_Alias;

   procedure Build_Decl_Instance (Mem : Memory_Ptr;
                                  Inst : Synth_Instance_Acc;
                                  Decl : Node) is
   begin
      case Get_Kind (Decl) is
         when Iir_Kind_Suspend_State_Declaration  =>
            declare
               Var_Info : constant Object_Info_Acc := Get_Info (Decl);
               Src : constant Valtyp := Get_Value (Inst, Decl);
               Dst_Mem : Memory_Ptr;
            begin
               Dst_Mem := Get_Var_Mem (Mem, Var_Info.Object_Var);

               --  The initial value should be 0.
               pragma Assert (Read_I32 (Src.Val.Mem) = 0);
               Write_I32 (Dst_Mem, 0);

               Src.Val.Mem := Dst_Mem;
            end;
         when Iir_Kind_Interface_Signal_Declaration =>
            declare
               use Simul.Vhdl_Simul;
               Sig_Info : constant Signal_Info_Acc := Get_Info (Decl);
               Sig_Type : constant Node := Get_Type (Decl);
               Tinfo : constant Type_Info_Acc := Get_Info (Sig_Type);
               Src : constant Valtyp := Get_Value (Inst, Decl);
               E : Signal_Entry renames Signals_Table.Table (Src.Val.S);
               Valp : Memory_Ptr;
               Sig : Memory_Ptr;
            begin
               pragma Assert (Sig_Info.Signal_Driver = Null_Var);
               Build_Subtype_Indication
                 (Mem, Inst, Get_Subtype_Indication (Decl));

               --  Set Sig and Valp.
               Valp := Get_Var_Mem (Mem, Sig_Info.Signal_Valp);
               Sig := Get_Var_Mem (Mem, Sig_Info.Signal_Sig);

               if E.Collapsed_By = No_Signal_Index then
                  --  A normal signal

                  if Is_Unbounded_Type (Tinfo) then
                     E.Sig := Alloc_Mem (Size_Type (Src.Typ.W) * Sig_Size);

                     Build_Unbounded_Signal
                       (Valp, Sig, Tinfo, Sig_Type, Src.Typ, E.Val, E.Sig);
                  elsif Is_Complex_Type (Tinfo) then
                     E.Sig := Alloc_Mem (Size_Type (Src.Typ.W) * Sig_Size);
                     Write_Ptr (Sig, E.Sig);
                     Write_Ptr (Valp, E.Val);
                  else
                     E.Sig := Sig;
                     Write_Ptr (Valp, E.Val);
                  end if;
                  Create_Signal (E);
               else
                  --  A collapsed signal.
                  --  Copy sig.
                  --  FIXME: what about a sub part, need an offset!
                  Vhdl_Simul.Collapse_Signal (E);

                  if Is_Unbounded_Type (Tinfo) then
                     Build_Unbounded_Signal
                       (Valp, Sig, Tinfo, Sig_Type, Src.Typ, E.Val, E.Sig);
                  elsif Is_Complex_Type (Tinfo) then
                     Write_Ptr (Sig, E.Sig);
                     Write_Ptr (Valp, E.Val);
                  else
                     Elab.Vhdl_Objtypes.Copy_Memory
                       (Sig, E.Sig, Size_Type (Src.Typ.W) * Sig_Size);
                     Write_Ptr (Valp, E.Val);
                  end if;
               end if;
            end;
         when Iir_Kind_Interface_Package_Declaration =>
            declare
               Pkg_Inst : constant Synth_Instance_Acc :=
                 Get_Package_Object (Inst, Decl);
               Info : constant Ortho_Info_Acc := Get_Info (Decl);
               Id : constant Instance_Id_Type := Get_Instance_Id (Pkg_Inst);
               Pkg_Mem : Memory_Ptr;
               Dst_Mem : Memory_Ptr;
            begin
               if Get_Generic_Map_Aspect_Chain (Decl) /= Null_Node then
                  --  Also instantiated.
                  Build_Package_Instantiation (Mem, Pkg_Inst, Decl);
               else
                  pragma Assert (Id <= Instance_To_Mem_Table.Last);
                  Pkg_Mem := Instance_To_Mem_Table.Table (Id);
                  pragma Assert (Pkg_Mem /= null);
                  --  xxxSPEC: pointer to the spec env (generics, ...)
                  --  xxxBODY: pointers to the body env (contains the SPEC).
                  Dst_Mem := Get_Var_Mem (Mem, Info.Package_Instance_Spec_Var);
                  Write_Ptr (Dst_Mem, Pkg_Mem);
                  Dst_Mem := Get_Var_Mem (Mem, Info.Package_Instance_Body_Var);
                  Write_Ptr (Dst_Mem, Pkg_Mem);
               end if;
            end;

         when Iir_Kind_Interface_Type_Declaration
           | Iir_Kinds_Interface_Subprogram_Declaration =>
            null;

         when Iir_Kind_Signal_Declaration =>
            Build_Subtype_Indication
              (Mem, Inst, Get_Subtype_Indication (Decl));
            Build_Signal_Decl (Mem, Inst, Decl);
         when Iir_Kind_Delayed_Attribute
            | Iir_Kind_Quiet_Attribute
            | Iir_Kind_Stable_Attribute
            | Iir_Kind_Transaction_Attribute
            | Iir_Kind_Guard_Signal_Declaration =>
            Build_Signal_Decl (Mem, Inst, Decl);
         when Iir_Kind_Variable_Declaration
           | Iir_Kind_Interface_Constant_Declaration =>
            Build_Object_Decl (Mem, Inst, Decl);
         when Iir_Kind_Constant_Declaration =>
            --  Not for completion.
            if Get_Deferred_Declaration_Flag (Decl)
              or else Get_Deferred_Declaration (Decl) = Null_Node
            then
               if Trans.Chap7.Is_Static_Constant (Decl) then
                  return;
               end if;

               declare
                  Ind : constant Node := Get_Subtype_Indication (Decl);
                  Ind_Type : constant Node :=
                    Get_Type_Of_Subtype_Indication (Ind);
                  Def : constant Node := Get_Type (Decl);
                  Val : constant Valtyp := Get_Value (Inst, Decl);
               begin
                  --  For unbounded subtype indication, the real type is
                  --  defined by the value.
                  if Def /= Ind_Type
                    and then Is_Anonymous_Type_Definition (Def)
                  then
                     Build_Subtype_Definition (Mem, Def, Val.Typ);
                  else
                     Build_Subtype_Definition (Mem, Ind, Val.Typ);
                  end if;
                  Build_Object_Value (Mem, Inst, Decl);
               end;
            end if;
         when Iir_Kind_Object_Alias_Declaration =>
            declare
               Name : constant Node := Get_Name (Decl);
            begin
               case Get_Kind (Name) is
                  when Iir_Kind_External_Signal_Name
                    | Iir_Kind_External_Variable_Name =>
                     External_Names_Table.Append ((Mem, Inst, Decl));
                  when others =>
                     Build_Object_Alias (Mem, Inst, Decl);
               end case;
            end;
         when Iir_Kind_Attribute_Implicit_Declaration =>
            declare
               Attr : Node;
            begin
               Attr := Get_Attribute_Implicit_Chain (Decl);
               while Attr /= Null_Node loop
                  Build_Decl_Instance (Mem, Inst, Attr);
                  Attr := Get_Attr_Chain (Attr);
               end loop;
            end;

         when Iir_Kinds_External_Name =>
            External_Names_Table.Append ((Mem, Inst, Decl));

         when Iir_Kind_File_Declaration =>
            declare
               Var_Info : constant Object_Info_Acc := Get_Info (Decl);
               Dst_Mem : Memory_Ptr;
               Src : Valtyp;
            begin
               Dst_Mem := Get_Var_Mem (Mem, Var_Info.Object_Var);

               Src := Get_Value (Inst, Decl);
               Write_U32 (Dst_Mem, Ghdl_U32 (Src.Val.File));
            end;
         when Iir_Kind_Type_Declaration
           | Iir_Kind_Anonymous_Type_Declaration =>
            Build_Type_Definition (Mem, Inst, Get_Type_Definition (Decl));
         when Iir_Kind_Subtype_Declaration =>
            Build_Subtype_Indication
              (Mem, Inst, Get_Subtype_Indication (Decl));

         when Iir_Kind_Package_Declaration =>
            if not Is_Uninstantiated_Package (Decl) then
               declare
                  Pkg_Inst : constant Synth_Instance_Acc :=
                    Get_Package_Object (Inst, Decl);
                  Hdr : constant Node := Get_Package_Header (Decl);
               begin
                  if Hdr /= Null_Node then
                     Build_Decls_Instance
                       (Mem, Pkg_Inst, Get_Generic_Chain (Hdr));
                  end if;
                  Build_Decls_Instance
                    (Mem, Pkg_Inst, Get_Declaration_Chain (Decl));
               end;
            end if;
         when Iir_Kind_Package_Body =>
            declare
               Spec : constant Node := Get_Package (Decl);
               Pkg_Inst : Synth_Instance_Acc;
            begin
               if not Is_Uninstantiated_Package (Spec) then
                  Pkg_Inst := Get_Package_Object (Inst, Spec);
                  Build_Decls_Instance
                    (Mem, Pkg_Inst, Get_Declaration_Chain (Decl));
               end if;
            end;
         when Iir_Kind_Package_Instantiation_Declaration =>
            declare
               Pkg_Inst : constant Synth_Instance_Acc :=
                 Get_Package_Object (Inst, Decl);
            begin
               Build_Package_Instantiation (Mem, Pkg_Inst, Decl);
            end;
         when Iir_Kind_Package_Instantiation_Body =>
            declare
               Pkg_Inst : constant Synth_Instance_Acc :=
                 Get_Package_Object (Inst, Decl);
            begin
               Build_Decls_Instance
                 (Mem, Pkg_Inst, Get_Declaration_Chain (Decl));
            end;

         when Iir_Kind_Function_Declaration
           | Iir_Kind_Procedure_Declaration =>
            if Is_Second_Subprogram_Specification (Decl) then
               return;
            end if;
            declare
               Inter : Node;
            begin
               Inter := Get_Interface_Declaration_Chain (Decl);
               while Inter /= Null_Node loop
                  Build_Subtype_Indication
                    (Mem, Inst, Get_Subtype_Indication (Inter));
                  Inter := Get_Chain (Inter);
               end loop;
            end;
         when Iir_Kind_Function_Body
           | Iir_Kind_Procedure_Body =>
            null;
         when Iir_Kind_Protected_Type_Body =>
            --  Only subprograms spec.
            declare
               El : Node;
            begin
               El := Get_Declaration_Chain (Decl);
               while El /= Null_Node loop
                  if Get_Kind (El) in Iir_Kinds_Subprogram_Declaration then
                     Build_Decl_Instance (Mem, Inst, El);
                  end if;
                  El := Get_Chain (El);
               end loop;
            end;
         when Iir_Kind_Attribute_Declaration =>
            null;
         when Iir_Kind_Attribute_Specification =>
            declare
               Spec_Expr : constant Node := Get_Expression (Decl);
               Is_Static : constant Boolean :=
                 Get_Expr_Staticness (Spec_Expr) /= None;
               Val : Node;
            begin
               Val := Get_Attribute_Value_Spec_Chain (Decl);
               while Val /= Null_Node loop
                  Build_Object_Value (Mem, Inst, Val);
                  exit when Is_Static;
                  Val := Get_Spec_Chain (Val);
               end loop;
            end;
         when Iir_Kind_Component_Declaration
            | Iir_Kind_Group_Template_Declaration
            | Iir_Kind_Group_Declaration
            | Iir_Kind_Non_Object_Alias_Declaration
            | Iir_Kind_Psl_Default_Clock =>
            --  Not needed ?
            null;
         when Iir_Kind_Configuration_Specification
            | Iir_Kind_Disconnection_Specification
            | Iir_Kind_Use_Clause =>
            null;
         when others =>
            Error_Kind ("build_decl_instance", Decl);
      end case;
   end Build_Decl_Instance;

   procedure Build_Decls_Instance (Mem : Memory_Ptr;
                                   Inst : Synth_Instance_Acc;
                                   Chain : Node)
   is
      Decl : Node;
   begin
      Decl := Chain;
      while Decl /= Null_Node loop
         Build_Decl_Instance (Mem, Inst, Decl);
         Decl := Get_Chain (Decl);
      end loop;
   end Build_Decls_Instance;

   function To_Proc_Acc is new Ada.Unchecked_Conversion
     (System.Address, Grt.Processes.Proc_Acc);

   --  In the process table, instances and node are registered.
   --  But for compilation we need the compiled subprogram and its this
   --  pointer.
   procedure Override_Process (Old_Inst : Synth_Instance_Acc;
                               Old_Proc : Node;
                               Subprg : O_Dnode;
                               This : Memory_Ptr;
                               Mem : Memory_Ptr)
   is
      function To_Instance_Acc is new Ada.Unchecked_Conversion
        (Memory_Ptr, Grt.Processes.Instance_Acc);
   begin
      Process_Idx := Process_Idx + 1;

      --  Check matching process.
      if Process_Idx > Processes_Table.Last then
         raise Program_Error;
      elsif Processes_Table.Table (Process_Idx).Proc /= Old_Proc then
         raise Program_Error;
      elsif Processes_Table.Table (Process_Idx).Inst /= Old_Inst then
         raise Program_Error;
      end if;

      Processes_State (Process_Idx) :=
        (Subprg => To_Proc_Acc (Get_Address (Subprg)),
         This => To_Instance_Acc (This),
         Mem => Mem);
   end Override_Process;

   procedure Build_Process_Instance (Mem : Memory_Ptr;
                                     Inst : Synth_Instance_Acc;
                                     Proc : Node;
                                     Proc_This : Memory_Ptr)
   is
      Proc_Inst : constant Synth_Instance_Acc := Get_Sub_Instance (Inst, Proc);
      Proc_Info : constant Proc_Info_Acc := Get_Info (Proc);
      Proc_Ofield : constant O_Fnode :=
        Trans.Chap10.Get_Scope_Field (Proc_Info.Process_Scope);
      Proc_Mem : Memory_Ptr;
   begin
      Proc_Mem := Add_Field_Offset (Mem, Proc_Ofield);
      Build_Decls_Instance (Proc_Mem, Proc_Inst, Get_Declaration_Chain (Proc));

      Override_Process (Proc_Inst, Proc, Proc_Info.Process_Subprg,
                        Proc_This, Proc_Mem);
   end Build_Process_Instance;

   --  For association by expression.
   procedure Build_Port_Map_Aspect (Mem : Memory_Ptr;
                                    Inst : Synth_Instance_Acc;
                                    Stmt : Node)
   is
      Assoc : Node;
      Assoc_Info : Ortho_Info_Acc;
   begin
      Assoc := Get_Port_Map_Aspect_Chain (Stmt);
      while Assoc /= Null_Node loop
         if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression
           and then Get_Expr_Staticness (Get_Actual (Assoc)) < Globally
         then
            Assoc_Info := Get_Info (Assoc);
            --  FIXME: shouldn't is be Base_Mem ?
            Override_Process (Inst, Assoc, Assoc_Info.Inertial_Proc,
                              Mem, null);
         end if;
         Assoc := Get_Chain (Assoc);
      end loop;
   end Build_Port_Map_Aspect;

   procedure Link_Instance (Mem : Memory_Ptr; Decl : Node; Parent : Memory_Ptr)
   is
      Info : constant Block_Info_Acc := Get_Info (Decl);
   begin
      Write_Ptr (Add_Field_Offset (Mem, Trans.Rtis.Ghdl_Entity_Link_Rti),
                 To_Memory_Ptr (Get_Address (Info.Block_Rti_Const)));
      Write_Ptr (Add_Field_Offset (Mem, Trans.Rtis.Ghdl_Entity_Link_Parent),
                 Parent);
   end Link_Instance;

   procedure Link_Component (Link : Memory_Ptr; Stmt : Node; Sub : Memory_Ptr)
   is
      Info : constant Block_Info_Acc := Get_Info (Stmt);
   begin
      Write_Ptr
        (Add_Field_Offset (Link, Trans.Rtis.Ghdl_Component_Link_Instance),
         Sub);
      Write_Ptr
        (Add_Field_Offset (Link, Trans.Rtis.Ghdl_Component_Link_Stmt),
         To_Memory_Ptr (Get_Address (Info.Block_Rti_Const)));
   end Link_Component;

   procedure Build_Instantiation_Instance (Mem : Memory_Ptr;
                                           Base_Mem : Memory_Ptr;
                                           Inst : Synth_Instance_Acc;
                                           Stmt : Node)
   is
      Sub_Inst : constant Synth_Instance_Acc :=
        Get_Sub_Instance (Inst, Stmt);
      Info : constant Block_Info_Acc := Get_Info (Stmt);
      Hdr : constant Node := Get_Instantiated_Header (Stmt);
      Link : Memory_Ptr;
      Ptr : Memory_Ptr;
   begin
      Link := Add_Field_Offset (Mem, Info.Block_Link_Field);
      if Is_Component_Instantiation (Stmt) then
         --  A component.
         declare
            Comp : constant Node :=
              Get_Named_Entity (Get_Instantiated_Unit (Stmt));
            Ent_Inst : Synth_Instance_Acc;
         begin
            --  The component.
            Build_Decls_Instance (Link, Sub_Inst, Get_Generic_Chain (Comp));
            Build_Decls_Instance (Link, Sub_Inst, Get_Port_Chain (Comp));

            --  The entity.
            Ent_Inst := Get_Component_Instance (Sub_Inst);
            if Ent_Inst /= null then
               --  Only if bound.
               Ptr := Build_Elab_Instance (Ent_Inst);
               Link_Instance (Ptr, Get_Source_Scope (Ent_Inst), Link);
            else
               Ptr := null;
            end if;

            Link_Component (Link, Stmt, Ptr);
         end;
      else
         --  An entity (or a configuration).
         Ptr := Build_Elab_Instance (Sub_Inst);
         Link_Instance (Ptr, Get_Source_Scope (Sub_Inst), Link);

         if Hdr /= Null_Node then
            declare
               Ent_Info : constant Block_Info_Acc := Get_Info (Hdr);
               Orig_Mem : Memory_Ptr;
            begin
               --  Set the origin field.
               if Ent_Info /= null then
                  Orig_Mem := Add_Field_Offset
                    (Ptr, Ent_Info.Block_Origin_Field);
                  Write_Ptr (Orig_Mem, Base_Mem);
               end if;
            end;
         end if;

         Link_Component (Link, Stmt, Ptr);
      end if;

      Build_Port_Map_Aspect (Base_Mem, Inst, Stmt);
   end Build_Instantiation_Instance;

   procedure Build_Generate_Body_Instance (Mem : Memory_Ptr;
                                           Inst : Synth_Instance_Acc;
                                           Bod : Node;
                                           Parent_Mem : Memory_Ptr;
                                           It : Node)
   is
      Bod_Info : constant Block_Info_Acc := Get_Info (Bod);
      Orig_Mem : Memory_Ptr;
   begin
      Set_Instance_To_Mem (Inst, Mem);

      --  Set the origin field.
      Orig_Mem := Add_Field_Offset (Mem, Bod_Info.Block_Origin_Field);
      Write_Ptr (Orig_Mem, Parent_Mem);

      --  Iterator for for-generate statements.
      if It /= Null_Node then
         declare
            Var_Info : constant Ortho_Info_Acc := Get_Info (It);
            Src : constant Valtyp := Get_Value (Inst, It);
            Dst_Mem : Memory_Ptr;
         begin
            Dst_Mem := Get_Var_Mem (Mem, Var_Info.Iterator_Var);
            Elab.Vhdl_Objtypes.Copy_Memory (Dst_Mem, Src.Val.Mem, Src.Typ.Sz);
            Src.Val.Mem := Dst_Mem;
         end;
      end if;

      Build_Decls_Instance (Mem, Inst, Get_Declaration_Chain (Bod));
      Build_Stmts_Instance
        (Mem, Mem, Inst, Get_Concurrent_Statement_Chain (Bod));
   end Build_Generate_Body_Instance;

   function Build_Generate_Body_Instance (Inst : Synth_Instance_Acc;
                                          Bod : Node;
                                          Parent_Mem : Memory_Ptr;
                                          It : Node) return Memory_Ptr
   is
      Bod_Info : constant Block_Info_Acc := Get_Info (Bod);
      Bod_Otype : constant O_Tnode :=
        Trans.Chap10.Get_Scope_Type (Bod_Info.Block_Scope);
      Sz : Size_Type;
      Res : Memory_Ptr;
   begin
      Sz := Size_Type (Get_Byte_Size (Bod_Otype));
      Res := Alloc_Mem (Sz);

      Build_Generate_Body_Instance (Res, Inst, Bod, Parent_Mem, It);

      return Res;
   end Build_Generate_Body_Instance;

   function Find_Generate_Body_Id (Stmt : Node; Bod : Node) return Uns32
   is
      Res : Uns32;
      N : Node;
   begin
      pragma Assert (Get_Kind (Bod) = Iir_Kind_Generate_Statement_Body);
      Res := 0;
      case Get_Kind (Stmt) is
         when Iir_Kind_If_Generate_Statement =>
            N := Stmt;
            while N /= Null_Node loop
               if Get_Generate_Statement_Body (N) = Bod then
                  return Res;
               end if;
               Res := Res + 1;
               N := Get_Generate_Else_Clause (N);
            end loop;
            raise Internal_Error;
         when Iir_Kind_Case_Generate_Statement =>
            N := Get_Case_Statement_Alternative_Chain (Stmt);
            while N /= Null_Node loop
               if not Get_Same_Alternative_Flag (N) then
                  if Get_Associated_Block (N) = Bod then
                     return Res;
                  end if;
                  Res := Res + 1;
               end if;
               N := Get_Chain (N);
            end loop;
            raise Internal_Error;
         when others =>
            raise Internal_Error;
      end case;
   end Find_Generate_Body_Id;

   --  BASE_MEM is the address of the instance for processes, ie not an inner
   --  block.
   procedure Build_Stmt_Instance (Mem : Memory_Ptr;
                                  Base_Mem : Memory_Ptr;
                                  Inst : Synth_Instance_Acc;
                                  Stmt : Node) is
   begin
      case Get_Kind (Stmt) is
         when Iir_Kind_Sensitized_Process_Statement
            | Iir_Kind_Process_Statement =>
            Build_Process_Instance (Mem, Inst, Stmt, Base_Mem);
         when Iir_Kind_Component_Instantiation_Statement =>
            Build_Instantiation_Instance (Mem, Base_Mem, Inst, Stmt);
         when Iir_Kind_If_Generate_Statement
           | Iir_Kind_Case_Generate_Statement =>
            declare
               Sub : constant Synth_Instance_Acc :=
                 Get_Sub_Instance (Inst, Stmt);
               Info : constant Ortho_Info_Acc := Get_Info (Stmt);
               Bod : Node;
               Ptr : Memory_Ptr;
               Id : Uns32;
            begin
               if Sub /= null then
                  Bod := Get_Source_Scope (Sub);
                  Ptr := Build_Generate_Body_Instance
                    (Sub, Bod, Base_Mem, Null_Node);
                  Id := Find_Generate_Body_Id (Stmt, Bod);
               else
                  --  For if-generate: condition is false.
                  Ptr := null;
                  Id := 0;
               end if;

               --  Set links for RTIs.
               Write_Ptr
                 (Add_Field_Offset (Mem, Info.Generate_Parent_Field), Ptr);
               Write_Length
                 (Add_Field_Offset (Mem, Info.Generate_Body_Id), Id);
            end;
         when Iir_Kind_For_Generate_Statement =>
            declare
               Param : constant Node := Get_Parameter_Specification (Stmt);
               It_Rng : constant Type_Acc :=
                 Get_Subtype_Object (Inst, Get_Type (Param));
               It_Len : constant Natural :=
                 Natural (Get_Range_Length (It_Rng.Drange));
               Bod : constant Node := Get_Generate_Statement_Body (Stmt);
               Bod_Info : constant Block_Info_Acc := Get_Info (Bod);
               Bod_Otype : constant O_Tnode :=
                 Trans.Chap10.Get_Scope_Type (Bod_Info.Block_Scope);
               Sz : Size_Type;

               Gen_Inst : Synth_Instance_Acc;
               Sub_Inst : Synth_Instance_Acc;
               Ptr : Memory_Ptr;
               Arr_Ptr : Memory_Ptr;
            begin
               --  Parameter subtype.
               Build_Subtype_Indication
                 (Mem, Inst, Get_Subtype_Indication (Param));

               --  Allocate array of instances (for RTIs).
               Sz := Size_Type (Get_Byte_Size (Bod_Otype));
               Arr_Ptr := Alloc_Mem (Size_Type (It_Len) * Sz);
               Write_Ptr (Add_Field_Offset (Mem, Bod_Info.Block_Parent_Field),
                          Arr_Ptr);

               Gen_Inst := Get_Sub_Instance (Inst, Stmt);
               Ptr := Arr_Ptr;
               for I in 1 .. It_Len loop
                  Sub_Inst :=  Get_Generate_Sub_Instance (Gen_Inst, I);
                  Build_Generate_Body_Instance
                    (Ptr, Sub_Inst, Get_Source_Scope (Sub_Inst),
                     Base_Mem, Param);
                  Ptr := Ptr + Sz;
               end loop;
            end;
         when Iir_Kind_Block_Statement =>
            declare
               Info : constant Block_Info_Acc := Get_Info (Stmt);
               Block_Ofield : constant O_Fnode :=
                 Trans.Chap10.Get_Scope_Field (Info.Block_Scope);
               Sub_Mem : constant Memory_Ptr :=
                 Add_Field_Offset (Mem, Block_Ofield);
               Sub_Inst : constant Synth_Instance_Acc :=
                 Get_Sub_Instance (Inst, Stmt);
               Hdr : constant Node := Get_Block_Header (Stmt);
               Guard : constant Node := Get_Guard_Decl (Stmt);
            begin
               if Hdr /= Null_Node then
                  Build_Decls_Instance (Sub_Mem, Sub_Inst,
                                        Get_Generic_Chain (Hdr));
                  Build_Decls_Instance (Sub_Mem, Sub_Inst,
                                        Get_Port_Chain (Hdr));
               end if;
               if Guard /= Null_Node then
                  Build_Decl_Instance (Sub_Mem, Sub_Inst, Guard);
               end if;
               Build_Decls_Instance (Sub_Mem, Sub_Inst,
                                     Get_Declaration_Chain (Stmt));
               Build_Stmts_Instance (Sub_Mem, Base_Mem, Sub_Inst,
                                     Get_Concurrent_Statement_Chain (Stmt));
               if Hdr /= Null_Node then
                  Build_Port_Map_Aspect (Base_Mem, Inst, Hdr);
               end if;
            end;
         when Iir_Kind_Psl_Default_Clock
            | Iir_Kind_Psl_Declaration =>
            null;
         when Iir_Kind_Psl_Assert_Directive
            | Iir_Kind_Psl_Assume_Directive
            | Iir_Kind_Psl_Cover_Directive
            | Iir_Kind_Psl_Endpoint_Declaration =>
            declare
               Info : constant Psl_Info_Acc := Get_Info (Stmt);
               Psl_Ofield : constant O_Fnode :=
                 Trans.Chap10.Get_Scope_Field (Info.Psl_Scope);
               Psl_Mem : Memory_Ptr;
               Vec_Mem : Memory_Ptr;
               Vec_Len : Size_Type;
               Cnt_Mem : Memory_Ptr;
            begin
               Psl_Mem := Add_Field_Offset (Mem, Psl_Ofield);
               Vec_Mem := Get_Var_Mem (Psl_Mem, Info.Psl_Vect_Var);
               Vec_Len := Size_Type (Get_PSL_Nbr_States (Stmt));
               --  First state is true.
               Write_U8 (Vec_Mem, 1);
               --  Other states are false.
               for I in 1 .. Vec_Len - 1 loop
                  Write_U8 (Vec_Mem + I, 0);
               end loop;
               --  Set count var.
               Cnt_Mem := Get_Var_Mem (Psl_Mem, Info.Psl_Finish_Count_Var);
               if Get_Kind (Stmt) = Iir_Kind_Psl_Endpoint_Declaration then
                  --  In fact the value of the endpoint.
                  Write_U8 (Cnt_Mem, 0);
               else
                  Write_U32 (Cnt_Mem, 0);
                  Write_U32 (Cnt_Mem + 4, 0);
               end if;

               Override_Process (Inst, Stmt, Info.Psl_Proc_Subprg,
                                 Base_Mem, null);
            end;
         when others =>
            Error_Kind ("build_stmt_instance", Stmt);
      end case;
   end Build_Stmt_Instance;

   procedure Build_Stmts_Instance (Mem : Memory_Ptr;
                                   Base_Mem : Memory_Ptr;
                                   Inst : Synth_Instance_Acc;
                                   Chain : Node)
   is
      Stmt : Node;
   begin
      Stmt := Chain;
      while Stmt /= Null_Node loop
         Build_Stmt_Instance (Mem, Base_Mem, Inst, Stmt);
         Stmt := Get_Chain (Stmt);
      end loop;
   end Build_Stmts_Instance;

   function Build_Elab_Instance (Inst : Synth_Instance_Acc) return Memory_Ptr
   is
      Arch : constant Node := Get_Source_Scope (Inst);
      Arch_Info : constant Block_Info_Acc := Get_Info (Arch);
      Ent : constant Node := Get_Entity (Arch);
      Arch_Otype : constant O_Tnode :=
        Trans.Chap10.Get_Scope_Type (Arch_Info.Block_Scope);
      Sz : Size_Type;
      Res : Memory_Ptr;
      Res_Ent : Memory_Ptr;
   begin
      Sz := Size_Type (Get_Byte_Size (Arch_Otype));
      Res := Alloc_Mem (Sz);

      Set_Instance_To_Mem (Inst, Res);

      Res_Ent := Add_Field_Offset (Res, Arch_Info.Block_Parent_Field);
      Build_Decls_Instance (Res_Ent, Inst, Get_Generic_Chain (Ent));
      Build_Decls_Instance (Res_Ent, Inst, Get_Port_Chain (Ent));
      Build_Decls_Instance (Res_Ent, Inst, Get_Declaration_Chain (Ent));
      Build_Stmts_Instance
        (Res_Ent, Res_Ent, Inst, Get_Concurrent_Statement_Chain (Ent));

      Build_Decls_Instance (Res, Inst, Get_Declaration_Chain (Arch));
      Build_Stmts_Instance
        (Res, Res, Inst, Get_Concurrent_Statement_Chain (Arch));
      return Res;
   end Build_Elab_Instance;

   procedure Add_Direct_Driver
     (Typ : Type_Acc; Sig : Memory_Ptr; Drv : Memory_Ptr)
   is
      use Simul.Vhdl_Simul;
   begin
      case Typ.Kind is
         when Type_Logic
            | Type_Bit
            | Type_Discrete
            | Type_Float =>
            Grt.Signals.Ghdl_Signal_Add_Direct_Driver
              (Read_Sig (Sig), To_Ghdl_Value_Ptr (To_Address (Drv)));
         when Type_Vector
            | Type_Array =>
            declare
               Len : constant Uns32 := Typ.Abound.Len;
            begin
               for I in 1 .. Len loop
                  Add_Direct_Driver (Typ.Arr_El,
                                     Sig_Index (Sig, (I - 1) * Typ.Arr_El.W),
                                     Drv + Size_Type (I - 1) * Typ.Arr_El.Sz);
               end loop;
            end;
         when Type_Record =>
            for I in Typ.Rec.E'Range loop
               Add_Direct_Driver (Typ.Rec.E (I).Typ,
                                  Sig_Index (Sig, Typ.Rec.E (I).Offs.Net_Off),
                                  Drv + Typ.Rec.E (I).Offs.Mem_Off);
            end loop;
         when others =>
            raise Internal_Error;
      end case;
   end Add_Direct_Driver;

   procedure Create_Process_Direct_Drivers (I : Process_Index_Type)
   is
      use Simul.Vhdl_Simul;
--      P : Process_State_Type renames Processes_State (I);
      Proc : Proc_Record_Type renames Processes_Table.Table (I);
      Info : constant Proc_Info_Acc := Get_Info (Proc.Proc);
   begin
      Instance_Pool := Process_Pool'Access;

      Trans.Chap9.Set_Direct_Drivers (Proc.Proc);

      for J in Info.Process_Drivers.all'Range loop
         declare
            Ddrv : Direct_Driver_Type renames Info.Process_Drivers (J);
            Name : constant Node := Ddrv.Sig;
            Base_Name : constant Node := Get_Object_Prefix (Name);
            Base_Type : constant Node := Get_Type (Base_Name);
            Tinfo : constant Type_Info_Acc := Get_Info (Base_Type);
            Marker : Mark_Type;
            Typ : Type_Acc;
            Off : Value_Offsets;
            Sig : Valtyp;
            Ddrv_Mem, Ddrv_Addr : Memory_Ptr;
            Bnd : Memory_Ptr;
            F : O_Fnode;
         begin
            Mark_Expr_Pool (Marker);

            Synth.Vhdl_Stmts.Synth_Assignment_Prefix
              (Proc.Inst, Ddrv.Sig, Sig, Typ, Off);
            pragma Assert (Sig /= No_Valtyp);

            --  Set the direct driver variable.
            --  This is one once per signal (as the var is set only for the
            --  first driver of a signal).
            if Ddrv.Var /= Null_Var then
               --  Elaborate storage for the direct driver.
               Ddrv_Addr := Get_Var_Mem (Processes_State (I).Mem, Ddrv.Var);
               if Is_Unbounded_Type (Tinfo) then
                  --  TODO: Copy bounds from signal
                  Bnd := Build_Unbounded_Bounds (Tinfo, Base_Type, Sig.Typ);
                  F := Tinfo.B.Bounds_Field (Mode_Signal);
                  Write_Ptr (Add_Field_Offset (Ddrv_Addr, F), Bnd);
                  --  Allocate base
                  Ddrv_Mem := Alloc_Mem (Sig.Typ.Sz);
                  F := Tinfo.B.Base_Field (Mode_Signal);
                  Write_Ptr (Add_Field_Offset (Ddrv_Addr, F), Ddrv_Mem);
               elsif Is_Complex_Type (Tinfo) then
                  --  Allocate memory
                  Ddrv_Mem := Alloc_Mem (Sig.Typ.Sz);
                  Write_Ptr (Ddrv_Addr, Ddrv_Mem);
               else
                  Ddrv_Mem := Ddrv_Addr;
               end if;

               --  Initial value
               if Sig.Val.Init = null then
                  Write_Value_Default (Ddrv_Mem, Sig.Typ);
               else
                  Copy_Memory (Ddrv_Mem, Sig.Val.Init.Mem, Sig.Typ.Sz);
               end if;
            end if;

            declare
               Se : Signal_Entry renames Signals_Table.Table (Sig.Val.S);
               S : constant Memory_Ptr := Sig_Index (Se.Sig, Off.Net_Off);
            begin
               if Trans.Chap4.Has_Direct_Driver (Base_Name) then
                  Ddrv_Addr := Get_Var_Mem
                    (Processes_State (I).Mem,
                     Get_Info (Base_Name).Signal_Driver);
                  if Is_Unbounded_Type (Tinfo) then
                     Ddrv_Addr := Read_Ptr
                       (Add_Field_Offset (Ddrv_Addr,
                                          Tinfo.B.Base_Field (Mode_Value)));
                  elsif Is_Complex_Type (Tinfo) then
                     Ddrv_Addr := Read_Ptr (Ddrv_Addr);
                  end if;
                  Add_Direct_Driver (Typ, S, Ddrv_Addr + Off.Mem_Off);
               else
                  Simul.Vhdl_Simul.Add_Source
                    (Typ, S, Se.Val_Init + Off.Mem_Off);
               end if;
            end;

            Release_Expr_Pool (Marker);
         end;
      end loop;

      Trans.Chap9.Reset_Direct_Drivers (Proc.Proc);

      Instance_Pool := null;
   end Create_Process_Direct_Drivers;

   procedure Create_Process_Drivers (I : Process_Index_Type) is
   begin
      if Translation.Flag_Direct_Drivers then
         Create_Process_Direct_Drivers (I);
      else
         Simul.Vhdl_Simul.Create_Process_Drivers (I);
      end if;
   end Create_Process_Drivers;

   procedure Build_Elab_External_Names is
   begin
      for I in External_Names_Table.First .. External_Names_Table.Last loop
         declare
            E : constant External_Name_Record :=
              External_Names_Table.Table (I);
         begin
            --  TODO: handle external signal name of an external signal name.
            Build_Object_Alias (E.Mem, E.Inst, E.Name);
         end;
      end loop;
   end Build_Elab_External_Names;

   procedure Elaborate
   is
      use Vhdl.Configuration;
      Top : Memory_Ptr;
      Top_Arch : Node;
      Nbr_Pkgs : Natural;
   begin
      Build_Heap_Bounds;

      --  Build instances for the packages.
      Nbr_Pkgs := 1;
      for I in Design_Units.First .. Design_Units.Last loop
         declare
            Dunit : constant Node := Design_Units.Table (I);
            Lunit : constant Node := Get_Library_Unit (Dunit);
            Pkg_Inst : Synth_Instance_Acc;
         begin
            case Iir_Kinds_Library_Unit (Get_Kind (Lunit)) is
               when Iir_Kind_Package_Declaration =>
                  if not Is_Uninstantiated_Package (Lunit) then
                     Pkg_Inst := Get_Package_Object (Root_Instance, Lunit);
                     if Pkg_Inst /= null then
                        Build_Decls_Instance
                          (null, Pkg_Inst, Get_Declaration_Chain (Lunit));
                        Nbr_Pkgs := Nbr_Pkgs + 1;
                     end if;
                  end if;
               when Iir_Kind_Package_Body =>
                  declare
                     Spec : constant Node := Get_Package (Lunit);
                  begin
                     if not Is_Uninstantiated_Package (Spec) then
                        Pkg_Inst := Get_Package_Object (Root_Instance, Lunit);
                        if Pkg_Inst /= null then
                           Build_Decls_Instance
                             (null, Pkg_Inst, Get_Declaration_Chain (Lunit));
                        end if;
                     end if;
                  end;
               when Iir_Kind_Entity_Declaration
                 | Iir_Kind_Architecture_Body
                 | Iir_Kind_Configuration_Declaration
                 | Iir_Kind_Context_Declaration =>
                  null;
               when Iir_Kind_Package_Instantiation_Declaration =>
                  Pkg_Inst := Get_Package_Object (Root_Instance, Lunit);
                  if Pkg_Inst /= null then
                     Build_Package_Instantiation (null, Pkg_Inst, Lunit);
                  end if;
               when others =>
                  raise Internal_Error;
            end case;
         end;
      end loop;

      --  Build instances for the hierarchy.
      Top := Build_Elab_Instance (Vhdl_Elab.Top_Instance);
      Top_Arch := Get_Source_Scope (Vhdl_Elab.Top_Instance);
      Link_Instance (Top, Top_Arch, null);

      --  External names may reference signals or protected objects which
      --  may be created after the external name.
      Build_Elab_External_Names;

      --  Call ghdl_rti_add_top, with:
      --   number of pkgs, array of pkgs, arch rti, arch_instance
      --  Add packages
      declare
         use Grt.Rtis;
         function To_Ghdl_Rti_Arr_Acc is new Ada.Unchecked_Conversion
           (Memory_Ptr, Ghdl_Rti_Arr_Acc);

         function Get_Rti_Address (Var : O_Dnode) return Ghdl_Rti_Access is
         begin
            return To_Ghdl_Rti_Access (Get_Address (Var));
         end Get_Rti_Address;

         Pkgs : Ghdl_Rti_Arr_Acc;
         Pinfo : Ortho_Info_Acc;
      begin
         Pkgs := To_Ghdl_Rti_Arr_Acc
           (Alloc_Mem (Size_Type (Nbr_Pkgs * Ghdl_Rti_Access'Size / 8)));
         Ghdl_Rti_Add_Top
           (Grt.Types.Ghdl_Index_Type (Nbr_Pkgs), Pkgs,
            Get_Rti_Address (Get_Info (Top_Arch).Block_Rti_Const),
            To_Address (Top));

         Pinfo := Get_Info (Vhdl.Std_Package.Standard_Package);
         Ghdl_Rti_Add_Package
           (Get_Rti_Address (Pinfo.Package_Rti_Const));

         for I in Design_Units.First .. Design_Units.Last loop
            declare
               Dunit : constant Node := Design_Units.Table (I);
               Lunit : constant Node := Get_Library_Unit (Dunit);
               Pinst : Synth_Instance_Acc;
            begin
               if Get_Kind (Lunit) = Iir_Kind_Package_Declaration
                 and then not Is_Uninstantiated_Package (Lunit)
               then
                  Pinst := Get_Package_Object (Root_Instance, Lunit);
                  if Pinst /= null then
                     Pinfo := Get_Info (Lunit);
                     Ghdl_Rti_Add_Package
                       (Get_Rti_Address (Pinfo.Package_Rti_Const));
                  end if;
               end if;
            end;
         end loop;
      end;

      for I in Processes_Table.First .. Processes_Table.Last loop
         declare
            P : Process_State_Type renames Processes_State (I);
            Proc : constant Node := Processes_Table.Table (I).Proc;
         begin
            case Get_Kind (Proc) is
               when Iir_Kind_Sensitized_Process_Statement =>
                  if Get_Postponed_Flag (Proc) then
                     Grt.Processes.Ghdl_Postponed_Sensitized_Process_Register
                       (P.This, P.Subprg, null, System.Null_Address);
                  else
                     Grt.Processes.Ghdl_Sensitized_Process_Register
                       (P.This, P.Subprg, null, System.Null_Address);
                  end if;
                  Simul.Vhdl_Simul.Register_Sensitivity (I);
                  Create_Process_Drivers (I);
               when Iir_Kind_Process_Statement =>
                  if Get_Postponed_Flag (Proc) then
                     Grt.Processes.Ghdl_Postponed_Process_Register
                       (P.This, P.Subprg, null, System.Null_Address);
                  else
                     Grt.Processes.Ghdl_Process_Register
                       (P.This, P.Subprg, null, System.Null_Address);
                  end if;
                  Create_Process_Drivers (I);
               when Iir_Kind_Psl_Assert_Directive
                 | Iir_Kind_Psl_Assume_Directive
                 | Iir_Kind_Psl_Cover_Directive
                 | Iir_Kind_Psl_Endpoint_Declaration =>
                  Grt.Processes.Ghdl_Sensitized_Process_Register
                    (P.This, P.Subprg, null, System.Null_Address);
                  --  TODO: also async sensitivity ?
                  Simul.Vhdl_Simul.Register_Sensitivity (I);
                  --  Finalizer.
                  declare
                     Info : constant Psl_Info_Acc := Get_Info (Proc);
                  begin
                     if Info.Psl_Proc_Final_Subprg /= O_Dnode_Null then
                        Grt.Processes.Ghdl_Finalize_Register
                          (P.This,
                           To_Proc_Acc
                             (Get_Address (Info.Psl_Proc_Final_Subprg)));
                     end if;
                  end;
               when Iir_Kind_Association_Element_By_Expression =>
                  Grt.Processes.Ghdl_Sensitized_Process_Register
                    (P.This, P.Subprg, null, System.Null_Address);
                  Simul.Vhdl_Simul.Register_Sensitivity (I);
                  --  TODO: support direct drivers for inertial assocs
                  Simul.Vhdl_Simul.Create_Process_Drivers (I);
               when others =>
                  Error_Kind ("elaborate(process)", Proc);
            end case;
         end;
      end loop;

      Simul.Vhdl_Simul.Create_Connects;
      Simul.Vhdl_Simul.Create_Disconnections;
   end Elaborate;

   procedure Def (Decl : O_Dnode; Addr : System.Address)
     renames Ortho_Jit.Set_Address;

   procedure Foreign_Hook (Decl : Iir;
                           Info : Vhdl.Back_End.Foreign_Info_Type;
                           Ortho : O_Dnode)
   is
      use System;
      Res : Address;
   begin
      Res := Trans_Foreign.Get_Foreign_Address (Decl, Info);
      if Res /= Null_Address then
         Def (Ortho, Res);
      end if;
   end Foreign_Hook;

   procedure Simulation
   is
      use Elab.Vhdl_Insts;
      Err : Boolean;
   begin
      Ortho_Jit.Init;

      Translation.Foreign_Hook := Foreign_Hook'Access;
      Trans_Foreign.Init;

      Translation.Initialize;

      --  Set flags for whole translation.
      Translation.Flag_Discard_Unused := True;
      Translation.Flag_Discard_Unused_Implicit := True;
      Translation.Flag_Discard_Unused_Generate := True;

--      Translation.Flag_Direct_Drivers := False;
      Translation.Flag_Elaboration := False;

      --  Translate standard.
      Trans.Update_Node_Infos;
      Trans.Rtis.Generate_Library (Libraries.Std_Library, True);
      Translation.Translate_Standard (True);

      --  Translate units.
      --  FIXME: discard unused units ?
      for I in Elab_Units.First .. Elab_Units.Last loop
         declare
            Lunit : constant Node := Elab_Units.Table (I);
            Parent : constant Node := Get_Parent (Lunit);
            Dunit : Node;
         begin
            if Lunit /= Vhdl.Std_Package.Standard_Package then
               --  Get the design unit (to get the library).
               if Parent = Null_Node
                 or else
                 Get_Kind (Parent) = Iir_Kind_Component_Instantiation_Statement
               then
                  Dunit := Get_Design_Unit (Vhdl.Sem_Inst.Get_Origin (Lunit));
               else
                  Dunit := Parent;
               end if;
               Trans.Rtis.Generate_Library
                 (Get_Library (Get_Design_File (Dunit)), True);

               case Iir_Kinds_Library_Unit (Get_Kind (Lunit)) is
                  when Iir_Kind_Configuration_Declaration
                    | Iir_Kind_Context_Declaration =>
                     null;
                  when Iir_Kind_Package_Declaration =>
                     Translation.Translate (Lunit, True);
                  when Iir_Kind_Entity_Declaration =>
                     if Get_Kind (Parent) = Iir_Kind_Design_Unit then
                        Translation.Translate (Lunit, True);
                     end if;
                  when Iir_Kind_Package_Instantiation_Declaration
                    | Iir_Kind_Package_Body =>
                     Translation.Translate (Lunit, True);
                  when Iir_Kind_Architecture_Body =>
                     null;
                  when Iir_Kind_Foreign_Module =>
                     raise Internal_Error;
                  when Iir_Kinds_Verification_Unit =>
                     raise Internal_Error;
               end case;
            end if;
         end;
      end loop;

      --  Then architectures
      for I in Elab_Units.First .. Elab_Units.Last loop
         declare
            Lunit : constant Node := Elab_Units.Table (I);
         begin
            case Iir_Kinds_Library_Unit (Get_Kind (Lunit)) is
               when Iir_Kind_Entity_Declaration =>
                  --  Translate a macro-expanded entity which has been
                  --  instantiated through a component.
                  declare
                     Parent : constant Node := Get_Parent (Lunit);
                  begin
                     if Get_Kind (Parent)
                       = Iir_Kind_Component_Instantiation_Statement
                       and then Is_Component_Instantiation (Parent)
                     then
                        Translation.Translate (Lunit, True);
                     end if;
                  end;
               when Iir_Kind_Architecture_Body =>
                  Translation.Translate (Lunit, True);
               when others =>
                  null;
            end case;
         end;
      end loop;

      --  Set the addresses of grt routines.
      Trans_Link.Link;

      Def (Trans_Decls.Ghdl_Allocate,
           Elab.Vhdl_Heap.Ghdl_Allocate'Address);
      Def (Trans_Decls.Ghdl_Deallocate,
           Elab.Vhdl_Heap.Ghdl_Deallocate'Address);

      Trans.Coverage.Cover_Finalize;

      --  Link.
      Ortho_Jit.Link (Err);

      if Err then
         raise Program_Error;
      end if;

      --  From ghdlrun:
      Grtlink.Std_Standard_Boolean_RTI_Ptr :=
        Ortho_Jit.Get_Address (Trans_Decls.Std_Standard_Boolean_Rti);
      Grtlink.Std_Standard_Bit_RTI_Ptr :=
        Ortho_Jit.Get_Address (Trans_Decls.Std_Standard_Bit_Rti);
      if Vhdl.Ieee.Std_Logic_1164.Resolved /= Null_Iir then
         declare
            Decl : O_Dnode;
         begin
            Decl := Translation.Get_Resolv_Ortho_Decl
              (Vhdl.Ieee.Std_Logic_1164.Resolved);
            if Decl /= O_Dnode_Null then
               Grtlink.Ieee_Std_Logic_1164_Resolved_Resolv_Ptr :=
                 Ortho_Jit.Get_Address (Decl);
            end if;
         end;
      end if;

      --  Note: we don't want to finish ortho_jit as we still need to have
      --  access to the symbols.

      Processes_State := new Process_State_Array
        (Processes_Table.First .. Processes_Table.Last);
      Process_Idx := No_Process_Index;

      --  Set hooks for debugger.
      Synth.Vhdl_Expr.Hook_Signal_Expr :=
        Simul.Vhdl_Simul.Hook_Signal_Expr'Access;

      Simul.Main.Simulation;
   end Simulation;
end Simul.Vhdl_Compile;
